# mean of both relationship durations reported
df_wide$rel_duration_A <- df_wide$pre_rel_duration_y_A + df_wide$pre_rel_duration_m_A / 12 # in months
df_wide$rel_duration_B <- df_wide$pre_rel_duration_y_B + df_wide$pre_rel_duration_m_B / 12
df_wide$Relationship_Duration <- (df_wide$rel_duration_A + df_wide$rel_duration_B) / 2
# mean of both cohabiting duration reported
df_wide$hab_duration_A <- df_wide$pre_hab_duration_y_A + df_wide$pre_hab_duration_m_A / 12
df_wide$hab_duration_B <- df_wide$pre_hab_duration_y_B + df_wide$pre_hab_duration_m_B / 12
df_wide$Cohabiting_Duration <- (df_wide$hab_duration_A + df_wide$hab_duration_B) / 2
#Gender of Each Partner
df_wide$Gender_A <- factor(df_wide$gender_A, levels = c(1,2,3), labels = c('Male','Female', 'Other'))
df_wide$Gender_B <- factor(df_wide$gender_B, levels = c(1,2,3), labels = c('Male','Female', 'Other'))
#Same sex couples or not
df_wide$Same_Sex <- factor(df_wide$Gender_A == df_wide$Gender_B, levels = c(FALSE, TRUE), labels = c('Same-Sex Couple', 'Mixed-Sex Couple'))
#Handedness
df_wide$Handedness_A <- factor(df_wide$pre_handedness_A, levels = c(0, 1, 2), c('Right','Left', 'Ambidextrous'))
df_wide$Handedness_B <- factor(df_wide$pre_handedness_B, levels = c(0, 1, 2), c('Right','Left', 'Ambidextrous'))
# Income (mean of both partner's report)
merge_income <- function(income1, income2) {
merged_income <- numeric(length(income1))
# Loop through each pair of incomes
for (i in seq_along(income1)) {
# Handle NA
if (is.na(income1[i])) {
merged_income[i] <- income2[i]
}
else if (is.na(income2[i])) {
merged_income[i] <- income1[i]
}
# if both are informative, take mean and round
else if (income1[i] %in% 1:6 && income2[i] %in% 1:6) {
merged_income[i] <- round((income1[i] + income2[i]) / 2)
}
# if one is informative and the other not, use the informative one.
else if (income1[i] %in% 1:6) {
merged_income[i] <- income1[i]
}
else if (income2[i] %in% 1:6) {
merged_income[i] <- income2[i]
}
# Now we only have cases, where both are either 70 or 99. We simply report "undisclosed".
else {
merged_income[i] <- 99
}
}
return(merged_income)
}
# Apply the function
numeric_income <- merge_income(df_wide$pre_income_1_A, df_wide$pre_income_1_B)
# Convert to factor
df_wide$Household_Income <- factor(numeric_income, levels = c(1,2,3,4,5,6,70,99), labels = c(
"up to CHF 2'000.-",
"CHF 2'001.- to CHF 4'000.-",
"CHF 4'001.- to CHF 6'000.-",
"CHF 6'001.- to CHF 8'000.-",
"CHF 8'001.- to CHF 10'000.-",
"above CHF 10'000.-",
"I don't know",
"Undisclosed"
))
# Education for both separate
df_wide$Highest_Education_A <- factor(df_wide$pre_education_A, levels = c(1,2,3,4,5,6,7), labels = c(
"(still) no school diploma",
"compulsory education (9 years)",
"vocational training (apprenticeship)",
"Matura (university entrance qualification)",
"Bachelor's degree",
"Master's degree",
"Doctorate degree"
)
)
df_wide$Highest_Education_B <- factor(df_wide$pre_education_B, levels = c(1,2,3,4,5,6,7), labels = c(
"(still) no school diploma",
"compulsory education (9 years)",
"vocational training (apprenticeship)",
"Matura (university entrance qualification)",
"Bachelor's degree",
"Master's degree",
"Doctorate degree"
)
)
# Marital Status (married)
df_wide$Marital_Status_A <- df_wide$pre_mat_stat_A == 1
df_wide$Marital_status_B <- df_wide$pre_mat_stat_B == 1
# if at least one of them said they are married, we go for married
df_wide$Marital_Status <- factor((df_wide$Marital_Status_A + df_wide$Marital_status_B) > 0, levels = c(FALSE, TRUE), labels = c('Not Married', 'Married'))
# Children
df_wide$Children <- factor((df_wide$pre_child_option_A + df_wide$pre_child_option_B) > 0, levels = c(FALSE, TRUE), labels = c('Have Children', 'No Children'))
# number of chilren (ONLY FOR COUPLES THAT HAVE CHILDREN)
df_wide$nChildren_couples_with_children <- (df_wide$pre_child_nr_childs_A + df_wide$pre_child_nr_childs_B) / 2
# number of children if every couple is considered.
df_wide$nChildren_all_couples <- df_wide$nChildren_couples_with_children
df_wide$nChildren_all_couples[is.na(df_wide$nChildren_all_couples)] <- 0
# BMI (kg/m^2)
df_wide$pre_height_A <- df_wide$pre_height_A / 100 # to meters
df_wide$pre_height_B <- df_wide$pre_height_B / 100 # to meters
df_wide$BMI_A <- df_wide$pre_weight_A / (df_wide$pre_height_A^2)
df_wide$BMI_B <- df_wide$pre_weight_B / (df_wide$pre_height_B^2)
sample_measures <- c(
"Gender_A", "Gender_B", "Same_Sex",
"pre_age_A", "pre_age_B", "BMI_A", "BMI_B", "Handedness_A", "Handedness_B", # physical stats
"Household_Income", "Highest_Education_A", "Highest_Education_B", # SES
"Marital_Status", "Relationship_Duration", "Cohabiting_Duration",
"Children", "nChildren_all_couples", "nChildren_couples_with_children"
)
sample_table <- report_measures(df_wide, sample_measures, ICC=F)
rownames(sample_table) <- NULL
openxlsx::write.xlsx(sample_table, 'Output/AsPreregistred/Sample.xlsx')
print_df(sample_table)